Delphi Developer's Kit 1996/Delphi Developer's Kit 1996.iso/power/ini/profile.pas

Pascal/Delphi Source File | 1995-12-22 | 5KB | 202 lines

unit Profile;

interface

uses
  SysUtils, WinProcs, Classes, WinTypes, Messages, Graphics, Controls;

type
  TProfile = class(TComponent)
  private
    FDefaultText: string;
    FEntry: string;
    FFileName: string;
    FSection: string;
    FState: boolean;
    FText: string;
    FValue: Longint;
    procedure SetDefaultText(strText: string);
    procedure SetEntry(strEntry: string);
    procedure SetFileName(strFileName: string);
    procedure SetSection(strSection: string);
    function GetState: boolean;
    procedure SetState(bState: boolean);
    function GetText: string;
    procedure SetText(strText: string);
    function GetValue: Longint;
    procedure SetValue(lValue: Longint);
  public
    constructor Create(AOwner: TComponent); override;
  published
    property DefaultText: string read FDefaultText write SetDefaultText;
    property Entry: string read FEntry write SetEntry;
    property FileName: string read FFileName write SetFileName;
    property Section: string read FSection write SetSection;
    property State: boolean read GetState write SetState;
    property Text: string read GetText write SetText;
    property Value: longint read GetValue write SetValue;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Additional', [TProfile]);
end;

function StrToBool(strVal: string): boolean;
begin
  if (UpperCase(strVal) = 'TRUE') or (UpperCase(strVal) = 'YES') or (strVal = '1') then
    Result := True
  else
    Result := False;
end;

function BoolToStr(bVal: boolean): string;
begin
  if bVal then
    Result := 'True'
  else
    Result := 'False';
end;

constructor TProfile.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDefaultText := '';
  FEntry := '';
  FFileName := 'WIN.INI';
  FSection := '';
  FState := False;
  FText := '';
  FValue := 0;
end;

procedure TProfile.SetDefaultText(strText: string);
begin
  if strText <> FDefaultText then
    FDefaultText := strText;
end;

procedure TProfile.SetEntry(strEntry: string);
begin
  if strEntry <> FEntry then
    FEntry := strEntry;
end;

procedure TProfile.SetFileName(strFileName: string);
begin
  if strFileName <> FFileName then
    FFileName := strFileName;
end;

procedure TProfile.SetSection(strSection: string);
begin
  if strSection <> FSection then
    FSection := strSection;
end;

function TProfile.GetState: boolean;
begin
  Result := StrToBool(GetText);
end;

procedure TProfile.SetState(bState: boolean);
begin
  SetText(BoolToStr(bState));
end;

function TProfile.GetText: string;
var
  szSection, szEntry, szDefaultText, szText, szFile: PChar;
begin
  if (FSection <> '') and (FEntry <> '') and (FFileName <> '') then
  begin
    { Allocate some memory for PChars }
    szSection := StrAlloc(256);
    szEntry := StrAlloc(256);
    szDefaultText := StrAlloc(256);
    szText := StrAlloc(256);
    szFile := StrAlloc(256);

    try
      { Copy our properties into the PChars }
      StrPCopy(szSection, FSection);
      StrPCopy(szEntry, FEntry);
      StrPCopy(szDefaultText, FDefaultText);
      StrPCopy(szFile, FFileName);

      { Read the profile string }
      GetPrivateProfileString(szSection, szEntry, szDefaultText, szText, 256, szFile);
      FText := StrPas(szText);
      Result := FText;
    finally
      StrDispose(szSection);
      StrDispose(szEntry);
      StrDispose(szText);
      StrDispose(szDefaultText);
      StrDispose(szFile);
    end;
  end
  else
  begin
    FText := '';
    Result := '';
  end;
end;

procedure TProfile.SetText(strText: string);
var
  szEntry, szFile, szSection, szText: PChar;
  Success: Bool;
begin
  if (FSection <> '') and (FEntry <> '') and (FFileName <> '') then
  begin
    { Allocate some memory for PChars }
    szSection := StrAlloc(256);
    szEntry := StrAlloc(256);
    szText := StrAlloc(256);
    szFile := StrAlloc(256);

    try
      { Copy our properties into the PChars }
      StrPCopy(szSection, FSection);
      StrPCopy(szEntry, FEntry);
      StrPCopy(szText, strText);
      StrPCopy(szFile, FFileName);

      { Write the profile string }
      Success := WritePrivateProfileString(szSection, szEntry, szText, szFile);

      if Success then
        FText := strText;
    finally
      StrDispose(szEntry);
      StrDispose(szFile);
      StrDispose(szSection);
      StrDispose(szText);
    end;
  end;
end;

function TProfile.GetValue: longint;
begin
  try
    Result := StrToInt(GetText);
  except
    if StrToBool(GetText) then
      Result := 1
    else
      Result := 0;
  end;
end;

procedure TProfile.SetValue(lValue: longint);
begin
  SetText(IntToStr(lValue));
end;

end.